#!/usr/bin/env perl

use v5.14;
use utf8;
require bytes;

use File::Spec;
use XML::LibXML;
use Sereal::Decoder;

use constant XML_TEI_NS => 'http://www.tei-c.org/ns/1.0';

my $output_dir = shift or die 'Output directory not specified';

my $input = do { binmode STDIN; local $/; <> };

my $tei_header = <<HEADER;
<?xml version="1.0" encoding="utf-8"?>
<teiHeader type="text">
  <fileDesc>
    <titleStmt>
      <title xml:id="%s" xml:lang="ru">%s</title>
    </titleStmt>
  </fileDesc>
</teiHeader>
HEADER

my($missing_pages, $total_pages);
my($missing_signature, $total_signatures);
my($missing_date, $total_dates);
my($missing_time, $total_times);

my $decoder = Sereal::Decoder->new;
my $offset  = 0;
my @pages;
while(1) {
    my $talkpage = $decoder->decode_with_offset($input, $offset);
    my $consumed = $decoder->bytes_consumed;

    $offset += $consumed;

    push @pages, $talkpage if defined $talkpage
                           and @{ $talkpage->{conversations} // [] };
    $missing_pages++ unless @{ $talkpage->{conversations} // [] };
    $total_pages++;

    last if $offset >= bytes::length($input)
         or not $consumed;
}

convert_to_xml($_) for @pages;

printf STDERR "Missing signatures: %.02f%%\n", $missing_signature / $total_signatures * 100;
printf STDERR "Missing dates: %.02f%%\n",      $missing_date      / $total_dates      * 100;
printf STDERR "Missing timestamps: %.02f%%\n", $missing_time      / $total_times      * 100;
printf STDERR "Missing pages: %.02f%%\n",      $missing_pages     / $total_pages      * 100;

sub convert_to_xml {
    my $talkpage = shift;

    my $page_dir = File::Spec->catdir($output_dir, $talkpage->{id});
    mkdir $page_dir, 0755 or die "$page_dir: $!";

    open my $fh, '>:utf8', File::Spec->catfile($page_dir, 'head.xml');
    printf $fh $tei_header, $talkpage->{id}, $talkpage->{title};
    close $fh;

    for my $conversation (@{ $talkpage->{conversations} }) {
        my $xml = XML::LibXML::Document->new('1.0', 'utf-8');

        my $tei_corpus = _e('teiCorpus', $xml);
        $tei_corpus->setNamespace(XML_TEI_NS, '', 0);

        my $include = _e('include', $tei_corpus);
        _a($include, 'href', 'head.xml');
        $include->setNamespace('', 'xi', 1);

        my $TEI = _e('TEI', $tei_corpus);
        $TEI->setNamespace(XML_TEI_NS, '', 0);

        my $tei_header = _e('teiHeader', $TEI);
        _a($tei_header, 'type', 'text');

        my $text = _e('text', $TEI);
        _xa($text, 'id', state $ctr);
        _xa($text, 'lang', 'ru');
        _a($text, 'topic', $conversation->{topic});

        my $body = _e('body', $text);

        for my $phrase (@{ $conversation->{phrases} }) {
            my $div = _e('div', $body);
            $div->appendTextChild('text', $phrase->{text});

            my $closer = _e('closer', $div);
            $closer->appendTextChild('salute', $phrase->{signature});

            $missing_signature++ unless length $phrase->{signature};
            $total_signatures++;

            my $date_line = _e('dateLine', $div);
            $date_line->appendTextChild('time', $phrase->{time});
            $date_line->appendTextChild('date', $phrase->{date});

            $missing_time++ unless length $phrase->{time};
            $missing_date++ unless length $phrase->{date};
            $total_dates++;
            $total_times++;

            if($phrase->{reply_to}) {
                my $prt = _e('prt', $div);
                _a($prt, 'target', $phrase->{indent} == 1 ? '#main_stm' : "#$phrase->{reply_to}_phr"); # FIXME do not rely on indent

                _xa($div, 'id', "$phrase->{id}_phr");
            }
            else {
                _xa($div, 'id', 'main_stm');
            }
        }

        $xml->toFile(File::Spec->catfile($page_dir, "$ctr.xml"), 2);
        $ctr++;
    }
}

sub _e {
    my $e = XML::LibXML::Element->new(shift);
    if(@_) {
        my $parent = shift;
        if($parent->isa('XML::LibXML::Document')) {
            $parent->setDocumentElement($e);
        }
        else {
            $parent->appendChild($e);
        }
    }

    $e;
}

sub _a {
    shift->setAttribute(@_);
}

sub _xa {
    shift->setAttributeNS(XML_XML_NS, @_);
}
